diagramfbaseloaded := 1;

numeric wd#[][], ht#[][], dp#[][];

scantokens ("input " & jobname & ".dim");

def texoutput text t = for s = t: message s & "message "" enddef;

string monthname[]; monthname[1] = "Jan"; monthname[2] = "Feb"; monthname[3] = "Mar"; monthname[4] = "Apr"; monthname[5] = "May"; monthname[6] = "Jun"; monthname[7] = "Jul"; monthname[8] = "Aug"; monthname[9] = "Sep"; monthname[10] = "Oct"; monthname[11] = "Nov"; monthname[12] = "Dec";

string today; today = decimal day & " " & monthname[month] & " " & decimal year;

texoutput """"" & jobname & "";

def coordinate expr z = "" & decimal (xpart z/hppp) & "pt" & decimal (ypart z/hppp) & "pt" enddef;

def begindiagram (expr n) (text t) = begingroup; diagram:=n; character:=n; numeric hboxwd[], hboxht[], hboxdp[]; pair hboxl[]; texoutput "" & decimal diagram & ""; beginchar (character) (t) enddef;

def enddiagram = endchar; texoutput "" & decimal character & ""; texoutput ""; endgroup enddef;

vardef hboxtl@# = hboxl@# + (0, hboxht@#) enddef; vardef hboxtr@# = hboxl@# + (hboxwd@#, hboxht@#) enddef; vardef hboxr@# = hboxl@# + (hboxwd@#, 0) enddef; vardef hboxbr@# = hboxl@# + (hboxwd@#, -hboxdp@#) enddef; vardef hboxbl@# = hboxl@# + (0, -hboxdp@#) enddef;

vardef hboxwd#.@# = if unknown wd#[diagram]@#: eps else: wd#[diagram]@# fi enddef;

vardef hboxht#.@# = if unknown ht#[diagram]@#: eps else: ht#[diagram]@# fi enddef;

vardef hboxdp#.@# = if unknown dp#[diagram]@#: eps else: dp#[diagram]@# fi enddef;

def hboxes (text t) = for n = t: hboxwd[n] = hboxwd#[n] * hppp; hboxht[n] = hboxht#[n] * hppp; hboxdp[n] = hboxdp#[n] * hppp; endfor enddef;

vardef setbox@# text t = texoutput "" & decimal @# & "" & coordinate hboxl@#, t, ""; if proofing=2: prooflabel@# fi enddef;

vardef prooflabel@# = begingroup; localpen; pickup pencircle scaled .25pt; draw hboxbl@# – hboxtl@# – hboxtr@# – hboxbr@# – cycle; draw hboxl@# – hboxr@#; endgroup enddef;

def localpen = interim pen_lft:=0; interim pen_rt:=0; interim pen_top:=0; interim pen_bot:=0; if known currentbreadth: interim currentbreadth:=0; fi save currentpen, currentpen_path; pen currentpen; path currentpen_path; enddef;